// XMLLib version 1
//
// Author
//
//   Thomas Koos (info@muetze1.de)
//   www.muetze1.de
//
// License
//
//   This Source Code Form is subject to the terms of the Mozilla Public
//   License, v. 1.1. If a copy of the MPL was not distributed with this
//   file, You can obtain one at http://mozilla.org/MPL/1.1/.
//
// Description
//
//   Base class for string adapter. If you want to implement any new charset coding or
//   crypting, build your class on an derivation of this one. You have to implement the
//   Decode() and Encode() function and return the identifier on EncodingID for the XML
//   header (charset).
//
// Revision
//
//  $Id: StrAdapterBase.pas 18 2014-04-21 21:28:10Z muetze1@gmail.com $
//

Unit StrAdapterBase;

Interface

{$Z+}  // equal to $Z4 on newer compilers

uses
  StrAdapterOptions;    // for TStringAdapterOptions

Type
  TStringDataType = ( sdtNodeValue, sdtComment, sdtCDATA, sdtAttributeValue, sdtPIValues, sdtDTD );

    // Metaclass for working abstract with the string adapters
  TStringAdapterMetaClass = Class Of TBaseStringAdapter;

    // Base class for all string adapters to build an abstract interface for all
    // string en/decoders.
  TBaseStringAdapter = Class
  private
    procedure SetOptions(const Value: TStringAdapterOptions);
  protected
    fOptions: TStringAdapterOptions;

  public
    constructor Create(const AOptions: TStringAdapterOptions); virtual;

      // removed abstract for C++Builder/BDS
    class function EncodingID: string; virtual;

      // Abstract base function for decoding the passed string in the
      // given charset to return the decoded ansi string.
    function Decode(const AString: AnsiString): string; virtual; abstract;

      // Abstract base function for encoding the passed ansi string to the
      // given charset.
    function Encode(const AString: string): AnsiString; virtual; abstract;

      // Abstract base function for decoding the passed string in the
      // given charset to return the decoded ansi string.
    function DecodeEntity(var ADestination: PChar; const ACode: integer): boolean; overload; virtual; 
    function DecodeEntity(var ADestination: PChar; const ACodeData: string): boolean; overload; virtual;

      // Abstract base function for encoding the passed ansi string to the
      // given charset.
    function EncodeEntity(out ADestination: string; const ACode: integer; const AFormat: TSAEntityCoding): boolean; virtual;

      // Offering options for the string adapters
    property Options: TStringAdapterOptions read fOptions write SetOptions;
  End;

Implementation

uses
  SysUtils,             // for format()
  StrAdapterEntity;     // for coDefaultEntityTable[]

{ TBaseStringAdapter }

Constructor TBaseStringAdapter.Create(const AOptions: TStringAdapterOptions);
Begin
  Inherited Create;

  fOptions := AOptions;
End;

function TBaseStringAdapter.DecodeEntity(var ADestination: PChar; const ACode: integer): boolean;
var
  lCharShift, lCode: integer;
begin
  lCharShift := ord(high(Char));
  lCode := ACode;

  while lCode > 0 do
  begin
    ADestination^ := Char(lCode mod (lCharShift+1));
    lCode := lCode div lCharShift;
    Inc(ADestination);
  end;
  
  result := true;
end;

function TBaseStringAdapter.DecodeEntity(var ADestination: PChar; const ACodeData: string): boolean;
var
  lCode, i: Integer;
begin
  lCode := 0;
  for I := low(coDefaultEntityTable) to high(coDefaultEntityTable) do
  begin
    if coDefaultEntityTable[i].Name = ACodeData then
    begin
      lCode := coDefaultEntityTable[i].Unicode;
      break;
    end;
  end;

    // valid entity?
  if lCode > 0 then
    result := DecodeEntity(ADestination, lCode)
  else
    result := false;
end;

function TBaseStringAdapter.EncodeEntity(out ADestination: string; const ACode: integer; const AFormat: TSAEntityCoding): boolean;
var
  lFound: Boolean;
  I: Integer;
begin
  result := true;

  case AFormat of
//    saecDisabled: ;  result will be false
    saecDecimal:     ADestination := format('&#%d;', [ACode]);
    saecHexadecimal: ADestination := format('&#x%x;', [ACode]);
    saecNamed:
      begin
        lFound := false;

        for I := low(coDefaultEntityTable) to high(coDefaultEntityTable) do
        begin
          if ACode = coDefaultEntityTable[i].Unicode then
          begin
            ADestination := '&' + coDefaultEntityTable[i].Name + ';';

            lFound := true;
            break;
          end;
        end;

        if not lFound and ( ACode >= 160 ) then
          ADestination := format('&#%d;', [ACode]);
      end;
  else
    result := false;
  end;
end;

class function TBaseStringAdapter.EncodingID: string;
begin
  result := '';
end;

procedure TBaseStringAdapter.SetOptions(const Value: TStringAdapterOptions);
begin
  if ( fOptions = nil ) and ( Value <> nil ) then
    fOptions := Value;
end;

end.


